home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / SystemCode / fill.tcl < prev    next >
Text File  |  1994-03-16  |  4KB  |  184 lines
  1. #=============================================================================
  2. #    'Fill' routines.
  3. #=============================================================================
  4.  
  5. proc fillParagraph {} {
  6.     set pos [getPos]
  7.     set start [paraStart $pos] 
  8.     set finish [paraFinish $pos]
  9.     goto $start
  10.     set text [fillText $start $finish]
  11.     replaceText $start $finish $text "\r"
  12.     goto $pos
  13. }
  14.  
  15.  
  16. proc fillParagraphSentence {} {
  17.     set pos [getPos]
  18.     set start [paraStart $pos] 
  19.     set finish [paraFinish $pos]
  20.  
  21.     regsub -all "\[ \t\r\]+" [getText $start $finish] " " text
  22.     regsub -all {\. } $text "Δ" text
  23.     set result ""
  24.     foreach line [split $text "Δ"] {
  25.         if {[string length $line]} {
  26.             append result [breakIntoLines $line] ".\r"
  27.         }
  28.     }
  29.     replaceText $start $finish $result
  30.     goto $pos
  31. }
  32.  
  33. proc getEndpts {} {
  34.     if {[getPos] == [selEnd]} {
  35.         set start [getPos]
  36.         set finish [getMark]
  37.         if {$start > $finish} {
  38.             set temp $start
  39.             set start $finish
  40.             set finish $temp
  41.         }
  42.     } else {
  43.         set start [getPos]
  44.         set finish [selEnd]
  45.     }
  46.     return [list $start $finish]
  47. }
  48.  
  49.  
  50. proc fillRegion {} {
  51.     set ends [getEndpts]
  52.     set start [lineStart [lindex $ends 0]]
  53.     set finish [lindex $ends 1]
  54.     goto $start
  55.     set text [fillText $start $finish]
  56.     replaceText $start $finish $text "\r"
  57. }
  58.     
  59. proc wrapParagraph {} {
  60.     set pos [getPos]
  61.     set start [paraStart $pos] 
  62.     set finish [paraFinish $pos]
  63.     goto $start
  64.     wrapText $start $finish
  65.     goto $pos
  66. }
  67.  
  68. proc wrapRegion {} {
  69.     set ends [getEndpts]
  70.     set start [lineStart [lindex $ends 0]]
  71.     set finish [lindex $ends 1]
  72.     if {$start == $finish} {
  73.         set finish [maxPos]
  74.     }
  75.     wrapText $start $finish
  76. }
  77.     
  78. proc paraStart {pos} {
  79.     if {$pos == [maxPos]} {incr pos -1}
  80.     set res [search -n -f 0 -r 1 -l 0 {^([ \t]*|(%.*))$} $pos]
  81.     if {![string length $res]} {return 0}
  82.     return [nextLineStart [lindex $res 0]]
  83. }
  84.  
  85.  
  86. proc paraFinish {pos} {
  87.     set end [maxPos]
  88.     set res [search -n -f 1 -r 1 -l $end {^([ \t]*|(%.*))$} $pos]
  89.     if {![string length $res]} {return $end}
  90.     return [lindex $res 0]
  91. }
  92.  
  93.  
  94. proc oldParaStart {pos} {
  95.     set pos [lineStart $pos]
  96.     while {$pos > 0} {
  97.         set back [lineStart [expr $pos-1]]
  98.         if {$back < 0} {return 0}
  99.         if {[regexp "^\[ \t\]*\r$" [getText $back $pos]]} {return $pos}
  100.         set pos $back
  101.     }
  102.     return 0
  103. }
  104.  
  105.  
  106. proc oldParaFinish {pos} {
  107.     set end [maxPos]
  108.     while {$pos < $end} {
  109.         set next [nextLineStart $pos]
  110.         if {$pos == "-1"} {return $end}
  111.         if {[regexp "^\[ \t\]*\r$" [getText $pos $next]]} {return $pos}
  112.         set pos $next
  113.     }
  114.     return $end
  115. }
  116.  
  117.  
  118. # Remove text from window, transform, and insert back into window.
  119. #     Alternate version of fillText. Probably better but slower.
  120. # proc fillText {from to} {
  121. #     set text [getText $from $to]
  122. #     regsub -all "\[ \t\r\]+" $text " " text
  123. #     regsub -all {\. } $text {.  } text
  124. #     set text [string trimright [breakIntoLines $text]]
  125. #     set a "a"
  126. #     set a [breakIntoLines $a]
  127. #     regsub "a" $a "" a
  128. #     set a \r$a
  129. #     set b $a
  130. #     regsub -all [append b " "] $text $a text
  131. #     return $text
  132. # }
  133. proc fillText {from to} {
  134.     set text [getText $from $to]
  135.     regsub -all "\[ \t\r\]+" $text " " text
  136.     regsub -all {\. } $text {.  } text
  137.     return [string trim [breakIntoLines $text]]
  138. }
  139.  
  140. proc lineToParagraph {} {
  141.     global fillColumn
  142.     global leftFillColumn
  143.     saveVars
  144.     set fillColumn 10000
  145.     set leftFillColumn 0
  146.     fillRegion
  147.     restoreVars
  148. }
  149.  
  150. proc paragraphToLine {} {
  151.     global fillColumn
  152.     global leftFillColumn
  153.     saveVars
  154.     set fillColumn 75
  155.     set leftFillColumn 0
  156.     fillRegion
  157.     restoreVars
  158. }
  159.  
  160.  
  161. #set sentEnd {[.!?](\r| +)}
  162. set sentEnd {(\r\r|[.!?](\r| +))}
  163. set sentBeg {[\r ][A-Z]}
  164.  
  165. proc nextSentence {} {
  166.     global sentBeg sentEnd
  167.     if {![catch {search -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  168.         if {![catch {search -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  169.             goto [expr [lindex $mtch 0]+1]
  170.         }
  171.     }
  172. }
  173.  
  174.  
  175. proc prevSentence {} {
  176.     global sentBeg sentEnd
  177.     if {[catch {search -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  178.     if {![catch {search -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  179.         if {![catch {search -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  180.             goto [expr [lindex $mtch 0]+1]
  181.         }
  182.     }
  183. }
  184.